home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / spyrogimp.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2005-06-30  |  13.2 KB  |  365 lines
  1. ;; spyrogimp.scm -*-scheme-*-
  2. ;; Draws Spirographs, Epitrochoids and Lissajous Curves.
  3. ;; More info at http://netword.com/*spyrogimp
  4. ;; Version 1.2
  5. ;;
  6. ;; Copyright (C) 2003 by Elad Shahar <elad@wisdom.weizmann.ac.il>
  7. ;; 
  8. ;; This program is free software; you can redistribute it and/or
  9. ;; modify it under the terms of the GNU General Public License
  10. ;; as published by the Free Software Foundation; either version 2
  11. ;; of the License, or (at your option) any later version.
  12. ;; 
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17. ;; 
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program; if not, write to the Free Software
  20. ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23.  
  24. ; Internal function to draw the spyro.
  25. (define (script-fu-spyrogimp-internal img drw 
  26.              x1 y1 x2 y2   ; Bounding box.
  27.              type          ; = 0 (Spirograph), 1 (Epitrochoid), 2(Lissajous) .
  28.              shape         ; = 0 (Circle), 1 (Frame), >2 (Polygons) .
  29.              oteeth iteeth ; Outer and inner teeth.
  30.              margin hole-ratio 
  31.              start-angle   ; 0 <= start-angle < 360 .
  32.              tool          ; = 0 (Pencil), 1 (Brush), 2 (Airbrush) .
  33.              brush
  34.              color-method  ; = 0 (Single color), 1 (Grad. Loop Sawtooth), 2 (Grad. Loop triangle) .
  35.              color         ; Used when color-method = Single color .
  36.              grad          ; Gradient used in Gradient color methods.
  37.              )
  38.  
  39.     ; Find minimum number n such that it is divisible by both a and b.
  40.     ; (least common multiplier)
  41.     (define (calc-min-mult a b)
  42.       (let* ((c 1) (fac 2) (diva 0) (divb 0))
  43.         (while ( <= fac (max a b) )
  44.           (set! diva ( = 0 (fmod (/ a fac) 1) ) )
  45.           (set! divb ( = 0 (fmod (/ b fac) 1) ) )
  46.  
  47.           (if diva (set! a (/ a fac)))
  48.           (if divb (set! b (/ b fac)))
  49.  
  50.           (if (or diva divb) 
  51.                 (set! c (* c fac))
  52.                 (set! fac (+ 1 fac)) )
  53.         )
  54.         c
  55.       )
  56.     )
  57.  
  58.  
  59.   ; This function returns a list of samples according to the gradient.
  60.   (define (get-gradient steps color-method grad)
  61.     (if (= color-method 1)
  62.         ; option 1
  63.         ; Just return the gradient
  64.         (gimp-gradient-get-uniform-samples grad (min steps 50) FALSE)
  65.  
  66.         ; option 2
  67.         ; The returned list is such that the gradient appears two times, once
  68.         ; in the normal order and once in reverse. This way there are no color
  69.         ; jumps if we go beyond the edge
  70.         (let* (
  71.                 ; Sample the gradient into array "gr".
  72.                 (gr (gimp-gradient-get-uniform-samples grad (/ (min steps 50) 2) FALSE))
  73.                                                     
  74.                 (grn (car gr))  ; length of sample array.
  75.                 (gra (cadr gr)) ; array of color samples (R1,G1,B1,A1, R2,....)
  76.  
  77.                 ; Allocate array gra-new of size  (2 * grn) - 8,
  78.                 ; but since each 4 items is actually one (RGBA) tuple, 
  79.                 ; it contains 2x - 2 entries.
  80.                 (grn-new (+ grn grn -8))
  81.                 (gra-new (cons-array grn-new 'double))
  82.  
  83.                 (gr-index 0)
  84.                 (gr-index2 0)
  85.               )
  86.  
  87.               ; Copy original array gra to gra_new.
  88.               (while (< gr-index grn)
  89.                  (aset gra-new gr-index (aref gra gr-index))
  90.                  (set! gr-index (+ 1 gr-index))
  91.               )
  92.  
  93.               ; Copy second time, but in reverse
  94.               (set! gr-index2 (- gr-index 8))
  95.               (while (< gr-index grn-new)
  96.                  (aset gra-new gr-index (aref gra gr-index2))
  97.                  (set! gr-index (+ 1 gr-index))
  98.                  (set! gr-index2 (+ 1 gr-index2))
  99.  
  100.                  (if (= (fmod gr-index 4) 0)
  101.                    (set! gr-index2 (- gr-index2 8))
  102.                  )
  103.               )
  104.  
  105.               ; Return list.
  106.               (list grn-new gra-new)
  107.         )
  108.     )
  109.   )  
  110.  
  111.  
  112.   (let* ((steps (+ 1 (calc-min-mult oteeth iteeth)))
  113.          (*points* (cons-array (* steps 2) 'double))
  114.  
  115.          (ot 0)                         ; current outer tooth
  116.          (cx 0)                         ; Current x,y
  117.          (cy 0)
  118.  
  119.          ; If its a polygon or frame, how many sides does it have.
  120.          (poly (if (= shape 1) 4   ; A frame has four sides.
  121.                               (if (> shape 1) (+ shape 1) 0)))
  122.  
  123.          (2pi (* 2 *pi*))
  124.         
  125.          (drw-width (- x2 x1))
  126.          (drw-height (- y2 y1))
  127.          (half-width (/ drw-width 2))
  128.          (half-height (/ drw-height 2))
  129.          (midx (+ x1 half-width))
  130.          (midy (+ y1 half-height))
  131.  
  132.          (hole (* hole-ratio 
  133.                   (- (/ (min drw-width drw-height) 2) margin)
  134.                )
  135.          )
  136.          (irad (+ hole margin))
  137.  
  138.          (radx (- half-width irad))  ; 
  139.          (rady (- half-height irad)) ; 
  140.  
  141.          (gradt (get-gradient steps color-method grad))
  142.          (grada (cadr gradt)) ; Gradient array.
  143.          (gradn (car gradt))  ; Number of entries of gradients.
  144.  
  145.          ; Indexes
  146.          (grad-index 0)  ; for array: grada
  147.          (point-index 0) ; for array: *points*
  148.          (index 0)
  149.          )
  150.  
  151.  
  152.     ; Do one step of the loop.
  153.     (define (calc-and-step!)
  154.       (let* (
  155.              (oangle (* 2pi (/ ot oteeth)) )
  156.              (shifted-oangle (+ oangle (* 2pi (/ start-angle 360))) )
  157.              (xfactor (cos shifted-oangle))
  158.              (yfactor (sin shifted-oangle))
  159.              (lenfactor 1)
  160.              (ofactor (/ (+ oteeth iteeth) iteeth))
  161.  
  162.              ; The direction of the factor changes according
  163.              ; to whether the type is a sypro or an epitcorhoid.
  164.              (mfactor (if (= type 0) (- ofactor) ofactor))
  165.             )
  166.  
  167.         ; If we are drawing a polygon then compute a contortion
  168.         ; factor "lenfactor" which deforms the standard circle.
  169.         (if (> poly 2)
  170.           (let* (
  171.                   (pi4 (/ *pi* poly))
  172.                   (pi2 (* pi4 2))
  173.  
  174.                   (oanglemodpi2 (fmod (+ oangle 
  175.                                         (if (= 1 (fmod poly 2))
  176.                                            0 ;(/ pi4 2)
  177.                                            0 
  178.                                         )
  179.                                       )
  180.                                       pi2
  181.                                ))
  182.                 )
  183.                 (set! lenfactor (/ ( if (= shape 1) 1 (cos pi4) )
  184.                                    (cos
  185.                                      (if (< oanglemodpi2 pi4)
  186.                                        oanglemodpi2
  187.                                        (- pi2 oanglemodpi2)
  188.                                      )
  189.                                    )
  190.                                 )
  191.                 )
  192.           )
  193.         )
  194.  
  195.         (if (= type 2)
  196.           (begin  ; Lissajous
  197.             (set! cx (+ midx
  198.                         (* half-width (cos shifted-oangle)) ))
  199.             (set! cy (+ midy
  200.                         (* half-height (cos (* mfactor oangle))) ))
  201.           )
  202.           (begin  ; Spyrograph or Epitrochoid
  203.            (set! cx (+ midx
  204.                        (* radx xfactor lenfactor)
  205.                        (* hole (cos (* mfactor oangle) ) ) ))
  206.            (set! cy (+ midy
  207.                        (* rady yfactor lenfactor)
  208.                        (* hole (sin (* mfactor oangle) ) ) ))
  209.           )
  210.         )
  211.  
  212.       ;; Advance teeth
  213.       (set! ot (+ ot 1))
  214.     ))
  215.  
  216.  
  217.     ;; Draw all the points in *points* with appropriate tool.
  218.     (define (flush-points len)
  219.  
  220.         (if (= tool 0)
  221.           (gimp-pencil drw len *points*)              ; Use pencil
  222.           (if (= tool 1)
  223.             (gimp-paintbrush-default drw len *points*); use paintbrush
  224.             (gimp-airbrush-default drw len *points*)  ; use airbrush
  225.           )
  226.         )
  227.  
  228.         ; Reset points array, but copy last point to first
  229.         ; position so it will connect the next time.
  230.         (aset *points* 0 (aref *points* (- point-index 2)))
  231.         (aset *points* 1 (aref *points* (- point-index 1)))
  232.         (set! point-index 2)
  233.     )
  234.  
  235.  ;;
  236.  ;; Execution starts here.
  237.  ;;
  238.  
  239.     (gimp-context-push)
  240.  
  241.     (gimp-image-undo-group-start img)
  242.  
  243.     ; Set new color, brush, opacity, paint mode.
  244.     (gimp-context-set-foreground color)
  245.     (gimp-context-set-brush (car brush))
  246.     (gimp-context-set-opacity (* 100 (car (cdr brush))))
  247.     (gimp-context-set-paint-mode (car (cdr (cdr (cdr brush)))))
  248.  
  249.     (while (< index steps)
  250.  
  251.         (calc-and-step!)
  252.  
  253.         (aset *points* point-index cx)
  254.         (aset *points* (+ point-index 1) cy)
  255.         (set! point-index (+ point-index 2))
  256.  
  257.         ; Change color and draw points if using gradient.
  258.         (if (< 0 color-method)  ; use gradient.
  259.            (if (< (/ (+ grad-index 4) gradn) (/ index steps))
  260.              (begin
  261.               (gimp-context-set-foreground 
  262.                 (list 
  263.                   (* 255 (aref grada grad-index))
  264.                   (* 255 (aref grada (+ 1 grad-index)) )
  265.                   (* 255 (aref grada (+ 2 grad-index)) )
  266.                 )
  267.               )
  268.               (gimp-context-set-opacity (* 100 (aref grada (+ 3 grad-index) ) )  )
  269.               (set! grad-index (+ 4 grad-index))
  270.  
  271.               ; Draw points
  272.               (flush-points point-index)
  273.              )
  274.            )
  275.         )
  276.  
  277.         (set! index (+ index 1))
  278.     )
  279.  
  280.  
  281.     ; Draw remaining points.
  282.     (flush-points point-index)   
  283.  
  284.     (gimp-image-undo-group-end img)
  285.     (gimp-displays-flush)
  286.  
  287.     (gimp-context-pop)))
  288.  
  289.  
  290. ; This routine is invoked by a dialog.
  291. ; It is the main routine in this file.
  292. (define (script-fu-spyrogimp img drw 
  293.                              type shape
  294.                              oteeth iteeth 
  295.                              margin hole-ratio start-angle
  296.                              tool brush
  297.                              color-method color grad)
  298.   (let* 
  299.  
  300.        ; Get current selection to determine where to draw. 
  301.        (
  302.          (bounds (cdr (gimp-selection-bounds img)))
  303.          (x1 (car bounds))
  304.          (y1 (cadr bounds))
  305.          (x2 (caddr bounds))
  306.          (y2 (car (cdddr bounds)))
  307.        )
  308.  
  309.     (set! oteeth (trunc (+ oteeth 0.5)))
  310.     (set! iteeth (trunc (+ iteeth 0.5)))
  311.  
  312.     (script-fu-spyrogimp-internal img drw 
  313.              x1 y1 x2 y2
  314.              type shape
  315.              oteeth iteeth 
  316.              margin hole-ratio start-angle
  317.              tool brush
  318.              color-method color grad)
  319.   )
  320. )
  321.  
  322.  
  323. (script-fu-register "script-fu-spyrogimp"
  324.                     _"_Spyrogimp..."
  325.                     _"Draws Spirographs, Epitrochoids and Lissajous Curves. More info at http://netword.com/*spyrogimp"
  326.                     "Elad Shahar <elad@wisdom.weizmann.ac.il>"
  327.                     "Elad Shahar"
  328.                     "June 2003"
  329.                     "RGB*, INDEXED*, GRAY*"
  330.                     SF-IMAGE       "Image"         0
  331.                     SF-DRAWABLE    "Drawable"      0
  332.  
  333.                     SF-OPTION     _"Type"         '(_"Spyrograph"
  334.                                                     _"Epitrochoid"
  335.                                                     _"Lissajous")
  336.                     SF-OPTION     _"Shape"        '(_"Circle"
  337.                                                     _"Frame"
  338.                                                     _"Triangle"
  339.                                                     _"Square"
  340.                                                     _"Pentagon"
  341.                                                     _"Hexagon"
  342.                                                     _"Polygon: 7 sides"
  343.                                                     _"Polygon: 8 sides"
  344.                                                     _"Polygon: 9 sides"
  345.                                                     _"Polygon: 10 sides")
  346.                     SF-ADJUSTMENT _"Outer teeth"   '(86 1 120 1 10 0 0)
  347.                     SF-ADJUSTMENT _"Inner teeth"   '(70 1 120 1 10 0 0)
  348.                     SF-ADJUSTMENT _"Margin (pixels)" '(0 -10000 10000 1 10 0 1)
  349.                     SF-ADJUSTMENT _"Hole ratio"    '(0.4 0.0 1.0 0.01 0.1 2 0)
  350.                     SF-ADJUSTMENT _"Start angle"   '(0 0 359 1 10 0 0)
  351.  
  352.                     SF-OPTION     _"Tool"          '(_"Pencil"
  353.                                                      _"Brush"
  354.                                                      _"Airbrush")
  355.                     SF-BRUSH      _"Brush"         '("Circle (01)" 1.0 -1 0)
  356.  
  357.                     SF-OPTION     _"Color method"  '(_"Solid Color" 
  358.                                                      _"Gradient: Loop Sawtooth" 
  359.                                                      _"Gradient: Loop Triangle")
  360.                     SF-COLOR      _"Color"         '(0 0 0)
  361.                     SF-GRADIENT   _"Gradient"       "Deep Sea")
  362.  
  363. (script-fu-menu-register "script-fu-spyrogimp"
  364.                          _"<Image>/Script-Fu/Render")
  365.